home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / swags-z / sorting.swg / 0048_Sort Object.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  5KB  |  191 lines

  1. {
  2.  
  3. Peterborough, Ontario, CANADA
  4.  
  5. Hi !
  6.  
  7.   If any of you boys have been reading BYTE magazine, you may have
  8.   noticed an article in the Dec/93 issue on Directory objects (in
  9.   C++ however). I was keenly interested in this article, because it
  10.   showed a quick and easy way to handle directory recursion - which
  11.   was necessary for a project I was doing.
  12.  
  13.   While the complete code listings weren't given, they were in C so
  14.   I couldn't use them directly anyways, so I just wrote my own
  15.   object in TP. (Works great, btw)
  16.  
  17.   I've decided to wake this conference up a bit so I'm going to post
  18.   this stuff over the next couple of days. The first installment is
  19.   the SORT unit which implements a binary-tree sorting object for
  20.   the sort method of the directory object. This object is completely
  21.   re-usable and extendable (designed so from the ground up) and
  22.   helps demonstrate more uses for OOP.
  23. ----------------------------------------------------------------------
  24. }
  25. Unit SORT;
  26.  
  27. INTERFACE
  28.  
  29. TYPE
  30.    comparefunc = function(d1, d2 :pointer):integer;
  31.                              { function returns sort value for data  }
  32.    ptree    = ^treenode;
  33.    treenode = record
  34.       data  :pointer;
  35.       left,
  36.       right :ptree;
  37.    end;
  38.                               { ****** Abstract sort object ******
  39.                                          Must be inherited
  40.                               }
  41.    pSortTree = ^oSortTree;
  42.    oSortTree = OBJECT
  43.       root    :ptree;
  44.       comp    :comparefunc;
  45.  
  46.       constructor Init(cf :comparefunc);
  47.       destructor  Done;
  48.  
  49.       procedure   InsertNode(n :pointer);
  50.       procedure   DeleteNode(var Node); virtual; { abstract }
  51.       function    ReadLeftNode:pointer;
  52.    end;
  53.  
  54. IMPLEMENTATION
  55.  
  56. constructor  oSortTree.Init(cf :comparefunc);
  57. begin
  58.    FillChar(self, SizeOf(self), #0); { zero out object data }
  59.    comp := cf; { set "compare" function to user defined far-local }
  60. end;
  61.  
  62. destructor   oSortTree.Done;
  63.  
  64.    procedure disposetree(var t :ptree);
  65.    begin
  66.       if t=NIL then
  67.          EXIT;
  68.       disposetree(t^.left);
  69.       disposetree(t^.right);
  70.       DeleteNode(t^.data);
  71.       dispose(t);
  72.    end;
  73.  
  74. begin
  75.    disposetree(root);
  76. end;
  77.  
  78. procedure    oSortTree.InsertNode(n :pointer);
  79.    { Insert the data pointer in sorted order, as defined by the
  80.      passed "compare" function
  81.    }
  82.    procedure recursetree(var t :ptree);
  83.  
  84.       procedure PutNode(node :ptree);
  85.       begin
  86.          node^.right := NIL;
  87.          node^.left  := NIL;
  88.          node^.data  := n;
  89.       end;
  90.  
  91.    begin
  92.       if comp(n, t^.data)>0 then
  93.       begin
  94.          if t^.right<>NIL then
  95.             recursetree(t^.right)
  96.          else
  97.          begin
  98.             New(t^.right);
  99.             PutNode(t^.right);
  100.          end;
  101.       end
  102.       else
  103.       begin
  104.          if t^.left<>NIL then
  105.             recursetree(t^.left)
  106.          else
  107.          begin
  108.             New(t^.left);
  109.             PutNode(t^.left);
  110.          end;
  111.       end;
  112.    end;
  113.  
  114. begin
  115.    if n<>NIL then
  116.       if root=NIL then
  117.       begin
  118.          New(root);
  119.          root^.left  := NIL;
  120.          root^.right := NIL;
  121.          root^.data  := n;
  122.       end
  123.       else
  124.          recursetree(root);
  125. end;
  126.  
  127. procedure    oSortTree.DeleteNode(var Node);
  128.    { The calling code must define how to dispose of the data field
  129.      by inheritance }
  130. begin
  131.    Halt(255); {abstract method}
  132. end;
  133.  
  134. function     oSortTree.ReadLeftNode:pointer;
  135.    { This function is intended to be called one-at-a-time to recover
  136.      data in sorted order. The data is returned as an untyped
  137.      pointer. It is assumed that the calling code will type the
  138.      pointer as required. The data pointer is set to NIL after being
  139.      passed to the caller. }
  140. var
  141.    ln :pointer;
  142.  
  143.    procedure recurseTree(var t :pTree;var result :pointer);
  144.    begin
  145.       if t^.left<>NIL then
  146.       begin
  147.          recurseTree(t^.left, result);
  148.          if result=NIL then
  149.          begin
  150.             result  := t^.data;
  151.             t^.data := NIL;
  152.          end;
  153.       end
  154.       else
  155.       begin
  156.          if t^.data<>NIL then
  157.          begin
  158.             result  := t^.data;
  159.             t^.data := NIL;
  160.          end
  161.          else
  162.             if t^.right<>NIL then
  163.             begin
  164.                recurseTree(t^.right, result);
  165.                if result=NIL then
  166.                begin
  167.                   dispose(t);
  168.                   t := NIL;
  169.                end
  170.             end
  171.             else
  172.             begin
  173.                dispose(t);
  174.                t := NIL;
  175.                result := NIL;
  176.             end;
  177.       end;
  178.    end;
  179.  
  180. begin
  181.    if root<>NIL then
  182.    begin
  183.       recurseTree(root, ln);
  184.       ReadLeftNode := ln;
  185.    end
  186.    else
  187.       ReadLeftNode := NIL;
  188. end;
  189.  
  190. END.
  191.